home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1994 November / macformat-018.iso / Utility Spectacular / Developer / SAT / HeartQuest sample ƒ / Preferences.p < prev    next >
Encoding:
Text File  |  1994-07-26  |  7.5 KB  |  265 lines  |  [TEXT/PJMM]
  1. {Preferences file handling}
  2.  
  3. {Principle: If we can write in the app itself, we do, but if not, or if there is already}
  4. {a prefs file, we use a pref file in the system folder. (The idea is that it is very elegant}
  5. {to save prefs in the application, whenever that is allowable.)}
  6.  
  7. {New version (march -94), stand-alone, takes file name and type as parameters,}
  8. {can be forced to create a pref file, includes resource copying routine.}
  9.  
  10. {What can we improve? Removing the last globals?}
  11. {Kolla "shared"-flagga och sätta alwaysExternal efter den? (Bra idé!) Kan man kolla om}
  12. {file sharing är på?}
  13.  
  14. unit Preferences;
  15.  
  16. {Made with help from the sources of}
  17. {DeHQX v2.0.0 © Peter Lewis, Aug 1991 }
  18. {Many thanks to Peter for sharing his sources with us!}
  19.  
  20. interface
  21.  
  22.     var
  23.         gAppFile, gPrefFile: integer; {refnumbers to pass to UseResFile.}
  24.         sysenv: SysEnvRec;
  25.  
  26.     function SetPrefFile (prefsFileName: Str255; prefCreator, prefType: OSType; alwaysExternal: Boolean): Boolean;
  27. {Open the pref file if needed. Set the global variables gAppFile and gPrefFile.}
  28. {If alwaysExternal is true, we always want a pref file in the system folder even if we can save in the application.}
  29. {Returns true if a new gPrefFile was created.}
  30.  
  31. {Copy a resource from one file to another. Useful when SetPrefFile returns true!}
  32.     function CopyResource (fromFile, toFile: integer; theResType: ResType; id: integer): OSErr;
  33.  
  34. implementation
  35.  
  36. { 1) hitta Preferencefolder}
  37. { 2) Kolla om prefsfil existerar. I så fall, öppna den och gå till 6. }
  38. { 3) Hämta resurs och ändra den med ChangeResource. Om det gick, gå till 6.}
  39. { 4) Skapa prefsfil och öppna den.}
  40. { 5) Hämta resurser ur programmet och kopiera in i prefsfilen}
  41. { 6) Hämta resurser och skapa om de inte finns.}
  42.  
  43.     const
  44. {Följande inte längre hårdkodat!!!}
  45. {PrefsFileName = 'Hexmap Prefs';}
  46. {PrefCreator = '»Hex';}
  47. {PrefType = 'Pref';}
  48.  
  49. { From Folders:}
  50.         kPreferencesFolderType = 'pref';        {preferences for applications go here}
  51.  
  52. { From Folders:}
  53.     function FindFolder (vRefNum: INTEGER; folderType: OSType; createFolder: BOOLEAN; var foundVRefNum: INTEGER; var foundDirID: LONGINT): OSErr;
  54.     inline
  55.         $7000, $A823;
  56.  
  57.     function GetBlessed (vRefNum: INTEGER; var blessed: longint; var volID: integer): OSErr;
  58.         var
  59.             myHPB: HParamBlockRec;
  60.             error: OSErr;
  61.     begin
  62.         blessed := 0;
  63.         with myHPB do
  64.             begin
  65.                 ioNamePtr := nil;
  66.                 ioVRefNum := vRefNum;    {get for default volume}
  67.                 ioVolIndex := 0;        {we’re not making indexed calls}
  68.                 error := PBHGetVInfo(@myHPB, FALSE);
  69.                 if error = noErr then
  70.                     begin
  71.                         blessed := ioVFndrInfo[1];
  72.                         volID := ioVRefNum;
  73.                     end;
  74.             end; {WITH}
  75.         GetBlessed := error;
  76.     end;
  77.  
  78.     function GetDirID (wdrn: integer; var vrn: integer; var dirID: longInt): OSErr;
  79.         var
  80.             procID: longInt;
  81.             oe: OSErr;
  82.     begin
  83.         oe := GetWDInfo(wdrn, vrn, dirID, procID);
  84.         if oe <> noErr then
  85.             begin
  86.                 vrn := wdrn;
  87.                 dirID := 0;
  88.             end;
  89.         GetDirID := oe;
  90.     end;
  91.  
  92.     function GetPrefsFolder (var ovrn: integer): OSErr;
  93.         var
  94.             vrn: integer;
  95.             sDirID: longint;
  96.             oe: OSErr;
  97.             pb: WDPBRec;
  98.             oDirID: longint; {förr var-deklarerad utvariabel}
  99.             oVolID: integer;{förr var-deklarerad utvariabel}
  100.     begin
  101.         vrn := sysenv.sysVRefNum;
  102. {ReportStr(stringof('SysEnv: ', sysenv.sysVRefNum));}
  103.         if sysenv.systemVersion >= $0700 then {System7}
  104.             begin
  105. {oe := GetBlessed(ovrn, oDirID, oVolID);}
  106.                 sDirID := 0;
  107.                 oe := GetDirID(vrn, vrn, sDirID);
  108. {ReportStr(stringof('kjsajkd: ', vrn, ' ', sDirID));}
  109.                 oe := FindFolder(vrn, kPreferencesFolderType, true, oVolID, oDirID);
  110. {ReportStr(stringof('FindFolder: ', oVolID, ' ', oDirID));}
  111. {ovrn := sysenv.sysVRefNum;}
  112.  
  113. {Konvertera FindFolders volref+dirid till WDref}
  114.                 pb.ioVRefNum := oVolID;
  115.                 pb.ioWDProcID := longint('ERIK');
  116.                 pb.ioWDDirID := oDirID;
  117.                 pb.ioWDIndex := 0;
  118. {pb.ioWDVRefNum := -1; {???}
  119.                 pb.ioNamePtr := nil;
  120.                 pb.ioCompletion := nil;
  121.                 oe := PBOpenWD(@pb, false);
  122.                 ovrn := pb.ioVRefNum; {WDRefNum}
  123.             end
  124.         else
  125.             begin
  126.                 ovrn := vrn;
  127. {oe := GetBlessed(ovrn, oDirID, oVolID);}
  128.                 oe := NoErr;
  129.             end;
  130.         GetPrefsFolder := oe;
  131.     end;
  132.  
  133. {function SetPrefFile: boolean;}
  134.     function SetPrefFile (prefsFileName: Str255; prefCreator, prefType: OSType; alwaysExternal: Boolean): Boolean;
  135.         var
  136.             err: OSErr;
  137.             PrefsFolder{, PrefsVolId}
  138.             : integer;
  139. {PrefsFolderId: longint;}
  140.             h: handle;
  141.             s: str255;
  142.     begin
  143.         gAppFile := CurResFile; {spara programmerts resursfilreferens}
  144.         gPrefFile := 0;
  145.         SetPrefFile := false;
  146. { 1) hitta Preferencefolder}
  147.         err := GetPrefsFolder(PrefsFolder);{, PrefsFolderId, PrefsVolId}
  148.         if err <> NoErr then
  149.             ;
  150. {ReportStr('Error finding system folder.')}
  151.  
  152. { 2) Kolla om prefsfil existerar. I så fall, öppna den och gå till 6. }
  153.         gPrefFile := OpenRFPerm(PrefsFileName, PrefsFolder, FSRdWrPerm);
  154.         if ResError = noErr then
  155.             begin
  156. {Vi borde kolla pref-fil-versionsnummer!}
  157.             end
  158.         else
  159.             begin
  160.                 gPrefFile := 0;
  161.  
  162. { 3) Hämta resurs och ändra den med ChangeResource. Om det gick, gå till 6.}
  163. {Om alwaysExternal är true behöver vi inte kolla - då vill vi ha en }
  164.                 if alwaysExternal then
  165.                     begin
  166.                         h := Get1Resource(prefCreator, 0); {Programmets signatur finns alltid om den har en BNDL.}
  167.                         if h = nil then
  168.                             begin
  169. {Error! Resursen saknas!}
  170. {ReportStr('Resource missing!');}
  171.                             end;
  172.                         ChangedResource(h);
  173.                         alwaysExternal := ResError <> noErr; {Lite fult att ändra "always", men nu vill vi ju ha extern!}
  174.                         ReleaseResource(h); {OK, vi är klara med resursen}
  175.                     end;
  176.  
  177.                 if alwaysExternal then
  178.                     begin
  179. { 4) Skapa prefsfil och öppna den.}
  180.                         err := Create(PrefsFileName, PrefsFolder, PrefCreator, PrefType);
  181.                         if err = noErr then
  182.                             begin
  183.                                 ;
  184. {ReportStr('Application locked. Creating prefs file instead.')}
  185.  
  186.                                 HCreateResFile(PrefsFolder, 0, PrefsFileName);{???}
  187.                                 if ResError <> noErr then
  188.                                     begin
  189. {ReportStr('Couldn''t create resource fork!');}
  190.                                     end
  191.                                 else
  192.                                     gPrefFile := OpenRFPerm(PrefsFileName, PrefsFolder, FSRdWrPerm);
  193.  
  194.                                 if ResError = noErr then
  195.                                     SetPrefFile := true; {new pref file!}
  196. { 5) Hämta resurser ur programmet och kopiera in i prefsfilen}
  197.                             end{Create lyckades}
  198.                         else
  199. {ReportStr('Failed to create prefsfile!')}
  200.                             ;
  201.                     end; {Programmet skrivskyddat.}
  202.             end; {prefsfil existerade inte}
  203. { 6) Hämta resurser och skapa om de inte finns.}
  204.     end;
  205.  
  206.  
  207. {Kopiera resurs:}
  208.     function CopyResource (fromFile, toFile: integer; theResType: ResType; id: integer): OSErr;
  209.         var
  210.             oldResFile: integer;
  211.             res, rescopy: Handle;
  212.             wasLoaded: Boolean;
  213.             theID: integer;
  214.             theType: ResType;
  215.             theName: Str255;
  216.         procedure Barf;
  217.         begin
  218.             CopyResource := ResError;
  219.             UseResFile(oldResFile); {återställ}
  220.             exit(CopyResource);
  221.         end;
  222.         procedure CheckError;
  223.         begin
  224.             if ResError <> noErr then
  225.                 Barf;
  226.         end; {CheckError}
  227.     begin
  228.         oldResFile := CurResFile;
  229.         UseResFile(fromFile);
  230.         CheckError;
  231.  
  232.         SetResLoad(false);
  233.         res := Get1Resource(theResType, id);
  234. {Don't CheckError before doing SetResLoad(true)!!!}
  235.         SetResLoad(true);
  236.         CheckError;
  237.         if res <> nil then
  238.             begin
  239.                 wasLoaded := res^ = nil;
  240.                 LoadResource(res);
  241.                 CheckError;
  242.                 UseResFile(toFile);
  243.                 CheckError;
  244.                 GetResInfo(res, theID, theType, theName);
  245.                 CheckError;
  246.                 rescopy := res;
  247.                 if HandToHand(rescopy) <> noErr then
  248.                     Barf; {i stället för DetachResource(res);}
  249.                 CheckError;
  250.                 AddResource(rescopy, theResType, id, theName);
  251.                 CheckError;
  252.                 ReleaseResource(rescopy);
  253.                 if not wasLoaded then
  254.                     ReleaseResource(res); {If it wasn't loaded before, it shouldn't be afterwards.}
  255.                 CheckError;
  256.                 CopyResource := noErr;
  257.             end
  258.         else
  259.             begin
  260.                 CopyResource := resNotFound;
  261.             end;
  262.         UseResFile(oldResFile);
  263.     end;
  264.  
  265. end.